Amiga Plus 2000 #4/Amiga Plus CD - 2000 - No. 4.iso/Tools/Grafik/Viewer/AnimFX/Src/AnimFX.1.57.p

Text File | 1995-06-10 | 46.2 KB | 1,389 lines

Program IFF;

{Anzeigezeit des Screenmoderequesters abziehen!}
{in UNDOLASTFRAME checken, ob LoadSEntry gleiche Position wie LoadDEntry hat}

{$incl"libraries/dos.h","intuition.lib","graphics.lib","exec/memory.h",
      "aga.lib","soundplay.mod","reqtools.h"}

type TagArr=array [1..10] of long;
type LArr16=array [1..16] of long;


type p_PicListEntry=^PicListEntry;
type PicListEntry=record
        NextPicEntry            :p_PicListEntry;
        Flags                   :byte;
        FrameNum,MSecs          :long;
        PMemA,PMemL,CMemA,CMemL :long;
     end;

type p_SndListEntry=^SndListEntry;
type SndListEntry=record
        NextSndEntry    :p_SndListEntry;
        FrameNum        :long;
        SMemA,SMemL     :long;
     end;

var DataAddr                                    :^LArr16;
var IBase                                       :^IntuitionBase;
var f                                           :text;
var MyFReq                                      :^rtFileRequester;
var FirstSEntry                                 :SndListEntry;
var FirstDEntry                                 :PicListEntry;
var LoadSEntry,MySEntry,LastSEntry              :^SndListEntry;
var LoadDEntry,MyDEntry,LastDEntry              :^PicListEntry;

var ChunkName                                   :string[5];
var ChunkLength,Frames,l,SpaceMem,CMAPPos,
    ChunkPos,ChunkMemA,i,PlayFrame              :long;
var PlaySound                                   :array [1..2] of boolean;
var StartSec,EndSec,StartMSec,EndMSec           :long;
var FHandle                                     :BPTR;
var PathFR                                      :string[250];
var FileName                                    :string[100];
var ColorUsed,j,ColCnt,YOffset                  :integer;
var AScr                                        :byte;
var Tags                                        :TagArr;
var NeuScreen                                   :NewScreen;
var MyScreen                                    :array [1..2] of ^Screen;
var SoundMemA,SoundMemL                         :array [1..2] of long;
var LineSize,BodyAddr                           :long;
var SoundModeOffset,SoundModeLength,LoopNum     :word;
var LData                                       :^byte;
var s                                           :string;

var ErrorFlag,HeadFlag,FirstFrame,JumpAllowed   :Boolean;
var DeltaMemA,DeltaMemL,ScrMode,
    InEffectiveFrames                           :long;



procedure INITVARS;

begin
   LData:=ptr($BFE001); LData^:=LData^ or 2;
   IBase:=IntBase;
   Frames:=0;        InEffectiveFrames:=0;
   ErrorFlag:=false; HeadFlag:=false;
   FirstFrame:=true;
   DeltaMemA:=0;     SpaceMem:=0;     AScr:=1;
   CMAPPos:=0;       Scrmode:=0;      YOffset:=0;
   for i:=1 to 2 do begin
      MyScreen[i]:=NIL;
      SoundMemA[i]:=0;
      SoundMemL[i]:=0;
   end;
   FirstSEntry:=SndListEntry(NIL,0,0,0);
   FirstDEntry:=PicListEntry(NIL,0,0,0,0,0,0,0);
end;



procedure GAMEEXIT;

begin
   if MyScreen[AScr]<>NIL then CloseScreen(MyScreen[AScr]);
   if MyScreen[3-AScr]<>NIL then CloseScreen(MyScreen[3-AScr]);
   for i:=1 to 2 do MyScreen[i]:=NIL;
   for i:=1 to 2 do if SoundMemA[i]<>0 then begin
      FreeMem(SoundMemA[i],SoundMemL[i]);
      SoundMemA[i]:=0; SoundMemL[i]:=0;
   end;
   if SpaceMem<>0 then FreeMem(SpaceMem,8); SpaceMem:=0;
end;



function GETSCREENMODE(ScrMode :long):long;

var MySReq                      :^rtScreenModeRequester;
var Opened                      :boolean;
var TimeOutSec,TimeOutMSec      :long;

begin
   TimeOutSec:=IBase^.Seconds;
   TimeOutMSec:=IBase^.Micros;
   GETSCREENMODE:=0;
   if RTBase=NIL then begin
      RTBase:=OpenLibrary('reqtools.library',0);
      Opened:=true;
   end else Opened:=false;
   if RTBase<>NIL then begin
      MySReq:=rtAllocRequestA(RT_SCREENMODEREQ,NIL);
      if MySReq<>NIL then begin
         if ScrMode and $80000=0 then ScrMode:=ScrMode or $80000
          else ScrMode:=ScrMode and not $80000;
         Tags:=TagArr(RTSC_DisplayID,ScrMode,0,0,0,0,0,0,0,0);
         l:=rtChangeReqAttrA(MySReq,^Tags);
         Tags:=TagArr(0,0,0,0,0,0,0,0,0,0);
         if rtScreenModeRequestA(MySReq,'Select a new screenmode!',^Tags) then begin
            if ScrMode and $800=$800 then MySReq^.DisplayID:=MySReq^.DisplayID and $800;
            GETSCREENMODE:=MySReq^.DisplayID;
         end;
         rtFreeRequest(MySReq);
      end;
      if Opened then Closelib(RTBase);
   end;
   StartSec:=StartSec+(IBase^.Seconds-TimeOutSec);
   StartMSec:=StartMSec+(IBase^.Micros-TimeOutMSec);
end;



procedure WRITEX(s :string);

begin
   if FromWB then writeln(f,s) else writeln(s);
end;



procedure WRITEXX(s1,s2,s3 :string);

begin
   if FromWB then writeln(f,s1,s2,s3) else writeln(s1,s2,s3);
end;



procedure READCDXL;

type XLHeader=record
        CDXLType,Info                   :byte;
        CurrSize,PrevSize               :long;
        res1                            :word;
        CurrFrameNum,Width,Height,Depth :word;
        CMapSize,RawSoundSize           :word;
        res2,res3                       :long;
     end;

type PArr8=array [0..7] of PLANEPTR;

var ScrMode,ColCnt,Frames,LoadValue     :long;
var XLHD                                :XLHeader;
var BitMapSize,IMemA,CMemA,PlaneSize    :long;
var SMemA                               :array [1..2] of long;
var MyBitMap                            :BitMap;
var MyPArr8                             :PArr8;
var PlayRate                            :word;


procedure CDXLEXIT;

begin
   if IMemA<>0 then FreeMem(IMemA,BitMapSize);
   if CMemA<>0 then FreeMem(CMemA,XLHD.CMapSize);
   for i:=1 to 2 do if SMemA[i]<>0 then FreeMem(SMemA[i],XLHD.RawSoundSize);
end;


begin
   IMemA:=0; CMemA:=0; Frames:=0;
   for i:=1 to 2 do SMemA[i]:=0;
   l:=DosSeek(FHandle,0,OFFSET_BEGINNING);
   DMACON_WRITE^:=$000F;
   StartSec:=IBase^.Seconds;
   StartMSec:=IBase^.Micros;
   repeat
      Frames:=Frames+1;
      l:=DosRead(FHandle,^XLHD,sizeof(XLHeader));
      if Frames=1 then with XLHD do PlayRate:=round((1090*325)/RawSoundSize);
      if l=0 then begin
         repeat until NTREQ_READ^ and $0180<>0;
         WRITEXX('   Frames: ',intstr(Frames),'');
         WRITEX('           CDXL');
         l:=round((IBase^.Seconds-StartSec)*100+(IBase^.Micros-StartMSec)/10000);
         WRITEXX('          ',realstr(l/100,2),' sec');
         CDXLEXIT;
         exit;
      end;
      if not XLHD.CDXLType=1 then begin
         WRITEX('No IFF- or CDXL-Format!');
         CDXLEXIT;
         exit;
      end;
      if not (XLHD.Info and $0F in [$00,$01])
      or not (XLHD.Info and $F0 in [$00,$10]) then begin
         WRITEX('Unsupported CDXL-Format!');
         CDXLEXIT;
         exit;
      end;
      XLHD.CurrSize:=XLHD.CurrSize-sizeof(XLHeader);
      if MyScreen[1]=NIL then with XLHD do if CurrSize>0 then begin
         s:='   Screen: '+intstr(Width)+' x '+intstr(Height)+' x '+intstr(Depth);
         WRITEX(s);
         WRITEX('   Sound:  8 Bit');
         WRITEX('           11025 Hz');
         if Info and $10=$10 then WRITEX('           STEREO') else WRITEX('           MONO (Pseudo-STEREO)');

         BitMapSize:=(Width*Height) div 8*Depth;
         CMemA:=AllocMem(CMapSize,0);
         if CMemA=0 then exit;
         IMemA:=AllocMem(BitMapSize,MEMF_CHIP);
         if IMemA=0 then begin
            WRITEX('Not enough memory!');
            CDXLEXIT;
            exit;
         end;
         case Depth of
            1: ColCnt:=2;
            2: ColCnt:=4;
            3: ColCnt:=8;
            4: ColCnt:=16;
            5: ColCnt:=32;
            6: ColCnt:=64;
            7: ColCnt:=128;
            8: ColCnt:=256;
         end;
         for i:=1 to 2 do begin
            SMemA[i]:=AllocMem(RawSoundSize,MEMF_CHIP);
            if SMemA[i]=0 then begin
               CDXLEXIT;
               exit;
            end;
         end;
         if Info and $10=$10 then begin
            SoundModeLength:=RawSoundSize div 4;
            SoundModeOffset:=RawSoundSize div 2;
         end else begin
            SoundModeLength:=RawSoundSize div 2;
            SoundModeOffset:=0;
         end;

         SPVolA^:=64;                 SPVolB^:=64;
         SPFreqA^:=PlayRate;
         if Info and $10=$10 then SPFreqB^:=PlayRate else SPFreqB^:=pred(PlayRate);

         ScrMode:=$A1000;
         for j:=1 to 2 do if MyScreen[1]=NIL then begin
            if Info and $1=$1 then ScrMode:=ScrMode or $800;
            Tags:=TagArr(SA_DisplayID,   ScrMode,
                         SA_INTERLEAVED, _FALSE,
                         SA_DRAGGABLE,   _FALSE,
                         0,0,0,0);
            NeuScreen:=NewScreen(160-Width div 2,0,XLHD.Width,XLHD.Height,XLHD.Depth,0,0,0,
                                 CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL);
            for i:=1 to 2 do begin
               MyScreen[i]:=OpenScreenTagList(^NeuScreen,^Tags);
               if (MyScreen[i]=NIL) and (j>1) then begin
                  if i=2 then CloseScreen(MyScreen[1]);
                  MyScreen[1]:=NIL;
                  WRITEX('Couldn´t open screen!');
                  exit;
               end;
            end;
            ScrMode:=$21000;
         end;
         AScr:=1;
         PlaneSize:=Width*Height div 8;
         for i:=1 to Depth do MyPArr8[pred(i)]:=ptr(IMemA+PlaneSize*pred(i));
         if Depth<8 then for i:=succ(Depth) to 8 do MyPArr8[pred(i)]:=NIL;
         MyBitMap:=BitMap(Width div 8,Height,0,Depth,0,MyPArr8);
      end;
      if XLHD.CurrSize>0 then begin
         XLHD.CurrSize:=XLHD.CurrSize-DosRead(FHandle,ptr(CMemA),XLHD.CMapSize);
         LoadRGB4(^MyScreen[Ascr]^.ViewPort,ptr(CMema),ColCnt);

         l:=DosSeek(FHandle,XLHD.CurrSize-XLHD.RawSoundSize-BitMapSize,OFFSET_CURRENT);

         l:=DosRead(FHandle,ptr(IMemA),BitMapSize);
         BltBitMapRastPort(^MyBitMap,0,0,^MyScreen[Ascr]^.RastPort,0,0,XLHD.Width,XLHD.Height,192);

         l:=DosRead(FHandle,ptr(SMemA[AScr]),XLHD.RawSoundSize);

         SPAddrA^:=SMemA[AScr];       SPAddrB^:=SMemA[AScr]+SoundModeOffset;
         SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
         DMACON_WRITE^:=$8003; NTREQ_WRITE^:=$0180;
         ScreenToFront(MyScreen[AScr]); AScr:=3-AScr;
         if Frames>1 then repeat until NTREQ_READ^ and $0180<>0;
      end;
    until XLHD.CurrSize<=0;
end;



procedure READIFF;

type DPaintAnimHeader=record
        Version,Frames          :word;
        FPS,pad1,pad2,pad3      :byte;
     end;

Type BitMapHeader=Record
        Width,Height    :Word;
        dX,dY           :Integer;
        Depth,Mask      :Byte;
        Kompr,pad       :Boolean;
        transcolor      :Word;
        XAspect,YAspect :Byte;
        SWidth,SHeight  :integer
     End;

type AnimHeader=record
        Operation,Mask          :byte;
        Width,Height            :word;
        x,y                     :integer;
        AbsTime,RelTime         :long;
        Interleave              :byte;
        pad0                    :byte;
        Bits                    :long;
        pad                     :array [1..16] of byte;
     end;

type SXHeader=record;
        SampleDepth,FixedVolume                 :byte;
        Length,PlayRate,CompressionMethod       :long;
        UsedChannels,UsedMode                   :byte;
        PlayFreq                                :long;
        Loop                                    :word;
     end;

const MD_MONO=1;
const MD_STEREO=2;
const CH_LEFT=1;
const CH_RIGHT=2;
const CH_CENTER=4;

const MODE_LOADDATA=1;
const MODE_PLAYALONE=2;
const MODE_PLAYLOAD=3;

type DeLTA=record;
        DataPtr         :array[1..16] of long;
     end;

var DPAN                                :DPaintAnimHeader;
var BMHD                                :BitMapHeader;
var ANHD                                :AnimHeader;
var DLTA                                :DeLTA;
var SXHD                                :SXHeader;
var LoadValue,MaxLoad,LastFORMPos,
    RestFORMSize,PlayFrames,stFrameTime,
    LoopPos                             :long;
var i,j,Zeile,Plane,Count               :integer;
var PlayMode,MyAnimType                 :byte;
var SndPlay                             :boolean;



function OPENMYSCREENS(ScrMode :long):boolean;

var XOffset     :integer;

begin
   if MyScreen[1]<>NIL then exit;
   OPENMYSCREENS:=false;
   if ScrMode and $F0000=0 then begin
      if BMHD.Width<=320 then ScrMode:=Scrmode and not $8000;
      if BMHD.Height<=256 then ScrMode:=Scrmode and not $4;
      ScrMode:=ScrMode or $21000;
   end;
   if ScrMode and $8000=0 then XOffset:=160-(BMHD.Width div 2)
   else XOffset:=320-(BMHD.Width div 2);
   if ScrMode and $10000=$10000 then begin {*** NTSC ***}
      if ScrMode and $4=0 then YOffset:=100-(BMHD.Height div 2)
      else YOffset:=200-(BMHD.Height div 2)
   end else if ScrMode and $20000=$20000 then begin {*** PAL ***}
      if ScrMode and $4=0 then YOffset:=128-(BMHD.Height div 2)
      else YOffset:=256-(BMHD.Height div 2);
   end else YOffset:=0;
   Tags:=TagArr(SA_DisplayID,   ScrMode,
                SA_INTERLEAVED, _FALSE,
                SA_DRAGGABLE,   _FALSE,
                OSCAN_VIDEO,_TRUE,0,0);
   if (XOffset>=0) and (YOffset>=0) then begin
      Tags[7]:=0; Tags[8]:=0;
   end else WRITEX('           Overscan');
   for i:=1 to 2 do begin
      if YOffset<0 then NeuScreen:=NewScreen(XOffset,YOffset,BMHD.Width,BMHD.Height,BMHD.Depth,0,0,0,CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL)
      else NeuScreen:=NewScreen(XOffset,0,BMHD.Width,BMHD.Height+YOffset,BMHD.Depth,0,0,0,CUSTOMSCREEN+SCREENQUIET,NIL,'BigAnimFX',NIL,NIL);
      MyScreen[i]:=OpenScreenTagList(^NeuScreen,^Tags);
      if MyScreen[i]=NIL then begin
         if i=2 then CloseScreen(MyScreen[1]);
         MyScreen[1]:=NIL;
         exit;
      end;
   end;
   AScr:=1;
   if YOffset<0 then YOffset:=0;
   OPENMYSCREENS:=true;
end;



procedure CREATECOLORMAP(TAddr,SAddr :long);

var DataB       :^byte;
var DataW       :^word;
var DataL       :^long;
var i,j,Colors  :word;

begin
   DataW:=ptr(TAddr);    TAddr:=TAddr+2;
   Colors:=ChunkLength div 3;
   if Colors>ColCnt then Colors:=ColCnt;
   DataW^:=Colors;
   DataW:=ptr(TAddr); TAddr:=TAddr+2; DataW^:=0;
   for i:=1 to Colors do for j:=1 to 3 do begin
      DataL:=ptr(TAddr); TAddr:=TAddr+4;
      DataB:=ptr(SAddr); SAddr:=SAddr+1;
      DataL^:=$1000000*DataB^;
   end;
   DataL:=Ptr(TAddr); DataL^:=0;
end;



procedure READCHUNK;

begin
   l:=DosRead(FHandle,^ChunkName,4);
   ChunkName[5]:=chr(0);
   l:=l+DosRead(FHandle,^ChunkLength,4);
   if l<8 then ErrorFlag:=true;
end;




Procedure FileError;

Begin
   WRITEX('File Error!');
   ErrorFlag:=true;
End;



procedure ANIM8_32;


var i,j                         :long;
var Addr,PlaneAddr,ColumnCtr,
    ColumnTarget                :long;
var OpCode,Data1,Data2          :^long;
var OpCtr                       :long;
var NewVert                     :boolean;

begin
   DataAddr:=ptr(DeltaMemA);
   ColumnTarget:=BMHD.Width div 8;
   for i:=1 to 16 do if DataAddr^[i]<>0 then begin
      if i>BMHD.Depth then exit;
      Addr:=DataAddr^[i]+DeltaMemA;
      ColumnCtr:=-4;
      OpCtr:=0;
      PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
                      +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
      while ColumnCtr<ColumnTarget do begin

         OpCode:=ptr(Addr); Addr:=Addr+4;
         if OpCtr=0 then NewVert:=true;

         if NewVert then begin
            ColumnCtr:=ColumnCtr+4;
            PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
            OpCtr:=OpCode^;
            if OpCtr<>0 then begin
               OpCtr:=OpCode^;
               NewVert:=false;
               OpCode:=ptr(Addr); Addr:=Addr+4;
            end;
         end;

         if (ColumnCtr<ColumnTarget) and not NewVert then begin
            if OpCode^=0 then begin
               OpCode:=ptr(Addr); Addr:=Addr+4;
               Data1:=ptr(Addr);  Addr:=Addr+4;
               for j:=1 to OpCode^ do begin
                  Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  Data2^:=Data1^;
               end;
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80000000=0) then begin
               PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80000000=$80000000) then begin
               for j:=1 to (OpCode^ and $7FFFFFFF) do begin
                  Data1:=ptr(Addr);      Addr:=Addr+4;
                  Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  Data2^:=Data1^;
               end;
               OpCtr:=OpCtr-1;
            end;
         end;
      end;
   end;
end;



procedure ANIM8_16;


var i,j                         :integer;
var Addr,PlaneAddr,ColumnCtr,
    ColumnTarget                :long;
var OpCode,Data1,Data2          :^word;
var OpCtr                       :word;
var NewVert                     :boolean;

begin
   DataAddr:=ptr(DeltaMemA);
   ColumnTarget:=BMHD.Width div 8;
   for i:=1 to 16 do if DataAddr^[i]<>0 then begin
      if i>BMHD.Depth then exit;
      Addr:=DataAddr^[i]+DeltaMemA;
      ColumnCtr:=-2;
      OpCtr:=0;
      PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
                 +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
      while ColumnCtr<ColumnTarget do begin

         OpCode:=ptr(Addr); Addr:=Addr+2;
         if OpCtr=0 then NewVert:=true;

         if NewVert then begin
            ColumnCtr:=ColumnCtr+2;
            PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
            OpCtr:=OpCode^;
            if OpCtr<>0 then begin
               OpCtr:=OpCode^;
               NewVert:=false;
               OpCode:=ptr(Addr); Addr:=Addr+2;
            end;
         end;

         if (ColumnCtr<ColumnTarget) and not NewVert then begin
            if OpCode^=0 then begin
               OpCode:=ptr(Addr); Addr:=Addr+2;
               Data1:=ptr(Addr);  Addr:=Addr+2;
               for j:=1 to OpCode^ do begin
                  Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  Data2^:=Data1^;
               end;
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $8000=0) then begin
               PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $8000=$8000) then begin
               for j:=1 to (OpCode^ and $7FFF) do begin
                  Data1:=ptr(Addr);      Addr:=Addr+2;
                  Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  Data2^:=Data1^;
               end;
               OpCtr:=OpCtr-1;
            end;
         end;
      end;
   end;
end;



procedure ANIM7_32;


var i,j                         :integer;
var OpAddr,DAddr,PlaneAddr,
    ColumnCtr,ColumnTarget      :long;
var DataL1,DataL2               :^long;
var OpCode                      :^byte;
var OpCtr                       :byte;
var NewVert                     :boolean;

begin
   DataAddr:=ptr(DeltaMemA);
   ColumnTarget:=BMHD.Width div 8;
   for i:=1 to 8 do if DataAddr^[i]<>0 then begin
      if i>BMHD.Depth then exit;
      OpAddr:=DataAddr^[i]+DeltaMemA;
      DAddr:=DataAddr^[i+8]+DeltaMemA;
      ColumnCtr:=-4;
      OpCtr:=0;
      PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
                 +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
      while ColumnCtr<ColumnTarget do begin

         OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
         if OpCtr=0 then NewVert:=true;

         if NewVert then begin
            ColumnCtr:=ColumnCtr+4;
            PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
            OpCtr:=OpCode^;
            if OpCtr<>0 then begin
               OpCtr:=OpCode^;
               NewVert:=false;
               OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
            end;
         end;

         if (ColumnCtr<ColumnTarget) and not NewVert then begin
            if OpCode^=0 then begin
               OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
               DataL1:=ptr(DAddr);  DAddr:=DAddr+4;
               for j:=1 to OpCode^ do begin
                  DataL2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  DataL2^:=DataL1^;
               end;
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=0) then begin
               PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=$80) then begin
               for j:=1 to (OpCode^ and $7F) do begin
                  DataL1:=ptr(DAddr);     DAddr:=DAddr+4;
                  DataL2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  DataL2^:=DataL1^;
               end;
               OpCtr:=OpCtr-1;
            end;
         end;
      end;
   end;
end;



procedure ANIM7_16;


var i,j                         :integer;
var OpAddr,DAddr,PlaneAddr,
    ColumnCtr,ColumnTarget      :long;
var DataW1,DataW2               :^word;
var OpCode                      :^byte;
var OpCtr                       :byte;
var NewVert                     :boolean;

begin
   DataAddr:=ptr(DeltaMemA);
   ColumnTarget:=BMHD.Width div 8;
   for i:=1 to 8 do if DataAddr^[i]<>0 then begin
      if i>BMHD.Depth then exit;
      OpAddr:=DataAddr^[i]+DeltaMemA;
      DAddr:=DataAddr^[i+8]+DeltaMemA;
      ColumnCtr:=-2;
      OpCtr:=0;
      PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
                 +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
      while ColumnCtr<ColumnTarget do begin

         OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
         if OpCtr=0 then NewVert:=true;

         if NewVert then begin
            ColumnCtr:=ColumnCtr+2;
            PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
            OpCtr:=OpCode^;
            if OpCtr<>0 then begin
               OpCtr:=OpCode^;
               NewVert:=false;
               OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
            end;
         end;

         if (ColumnCtr<ColumnTarget) and not NewVert then begin
            if OpCode^=0 then begin
               OpCode:=ptr(OpAddr); OpAddr:=OpAddr+1;
               DataW1:=ptr(DAddr);  DAddr:=DAddr+2;
               for j:=1 to OpCode^ do begin
                  DataW2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  DataW2^:=DataW1^;
               end;
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=0) then begin
               PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=$80) then begin
               for j:=1 to (OpCode^ and $7F) do begin
                  DataW1:=ptr(DAddr);     DAddr:=DAddr+2;
                  DataW2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  DataW2^:=DataW1^;
               end;
               OpCtr:=OpCtr-1;
            end;
         end;
      end;
   end;
end;



procedure ANIM5;


var i,j                         :byte;
var Addr,PlaneAddr,ColumnCtr,
    ColumnTarget,EndAddr        :long;
var OpCode,Data1,Data2          :^byte;
var OpCtr                       :byte;
var NewVert                     :boolean;

begin
   DataAddr:=ptr(DeltaMemA);
   ColumnTarget:=BMHD.Width div 8;
   for i:=1 to 16 do if DataAddr^[i]<>0 then begin
      if i>BMHD.Depth then exit;
      with MyScreen[AScr]^.RastPort.BitMap^ do EndAddr:=long(Planes[pred(i)])+(BytesPerRow*Rows);
      Addr:=DataAddr^[i]+DeltaMemA;
      ColumnCtr:=-1;
      OpCtr:=0;
      PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])
                 +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
      while ColumnCtr<ColumnTarget do begin
         OpCode:=ptr(Addr); Addr:=Addr+1;
         if OpCtr=0 then NewVert:=true;

         if NewVert then begin
            ColumnCtr:=ColumnCtr+1;
            PlaneAddr:=long(MyScreen[AScr]^.RastPort.BitMap^.Planes[pred(i)])+ColumnCtr
                       +(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
            OpCtr:=OpCode^;
            if OpCtr<>0 then begin
               OpCtr:=OpCode^;
               NewVert:=false;
               OpCode:=ptr(Addr); Addr:=Addr+1;
            end;
         end;

         if (ColumnCtr<ColumnTarget) and not NewVert then begin
            if OpCode^=0 then begin
               OpCode:=ptr(Addr); Addr:=Addr+1;
               Data1:=ptr(Addr);  Addr:=Addr+1;
               for j:=1 to OpCode^ do if PlaneAddr<EndAddr then begin
                  Data2:=ptr(PlaneAddr); PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
                  Data2^:=Data1^;
               end;
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=0) then begin
               PlaneAddr:=PlaneAddr+(MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow*OpCode^);
               OpCtr:=OpCtr-1;
            end else if (OpCode^ and $80=$80) then begin
               for j:=1 to (OpCode^ and $7F) do begin
                  Data1:=ptr(Addr);      Addr:=Addr+1;
                  Data2:=ptr(PlaneAddr);
                  if PlaneAddr<EndAddr then Data2^:=Data1^;
                  PlaneAddr:=PlaneAddr+MyScreen[AScr]^.RastPort.BitMap^.BytesPerRow;
               end;
               OpCtr:=OpCtr-1;
            end;
         end;
      end;
   end;
end;



Procedure LiesZeile(Adr:Long; Plane :byte);

Var Count,Size          :Long;
var i,j                 :integer;
var Head,Body,Mem       :^Short;

Begin
   Adr:=Adr+(YOffset*MyScreen[Ascr]^.RastPort.BitMap^.BytesPerRow);
   If Not ErrorFlag Then Begin
      Size:=(BMHD.Width+7) div 8;
      If not BMHD.Kompr Then begin
         CopyMemQuick(BodyAddr,Adr,Size);
         BodyAddr:=BodyAddr+Size;
      End Else Begin
         i:=0;
         While (i<Size) and not ErrorFlag Do Begin
            Head:=ptr(BodyAddr); BodyAddr:=BodyAddr+1;
            If Head^>=0 Then Begin
               CopyMem(BodyAddr,Adr+i,Head^+1);
               BodyAddr:=BodyAddr+Head^+1;
               i:=i+Head^+1
            End Else Begin
               Body:=ptr(BodyAddr); BodyAddr:=BodyAddr+1;
               For j:=1 to 1-Head^ Do Begin
                  Mem:=Ptr(Adr+i);
                  Mem^:=Body^;
                  i:=i+1
               End
            End
         End
      End;
   End
End;



procedure HANDLESPACEMEM;

begin
   if MySEntry=NIL then begin
      if SpaceMem<>0 then FreeMem(SpaceMem,8);
      SpaceMem:=0;
      PlaySound[AScr]:=false;
      exit;
   end;
   if MySEntry^.FrameNum<>PlayFrame then begin
      PlaySound[AScr]:=false;
      exit;
   end;
   if MySEntry^.SMemL>=SoundMemL[AScr] then begin
      FreeMem(SoundMemA[AScr],SoundMemL[AScr]);
      SoundMemL[AScr]:=MySEntry^.SMemL;
      if SpaceMem<>0 then begin
         SoundMemA[AScr]:=AllocMem(SoundMemL[AScr],MEMF_CHIP);
         if SoundMemA[AScr]=0 then begin
            WRITEX('Not enough CHIP-memory for sampledata!');
            FreeMem(SpaceMem,8); SpaceMem:=0;
            PlaySound[AScr]:=false;
            exit;
         end;
      end;
   end;
   if SXHD.UsedMode=MD_STEREO then begin
      SoundModeLength:=MySEntry^.SMemL div 4;
      SoundModeOffset:=MySEntry^.SMemL div 2;
   end else begin
      SoundModeLength:=MySEntry^.SMemL div 2;
      SoundModeOffset:=0;
   end;
   PlaySound[AScr]:=true
end;



procedure FREESENTRY(FreeSEntry :p_SndListEntry);

begin
   if FreeSEntry^.SMemA<>0 then FreeMem(FreeSEntry^.SMemA,FreeSEntry^.SMemL);
   FreeMem(long(FreeSEntry),sizeof(p_SndListEntry));
end;



procedure FREEDENTRY(FreeDEntry :p_PicListEntry);

begin
   if FreeDEntry^.PMemA<>0 then FreeMem(FreeDEntry^.PMemA,FreeDEntry^.PMemL);
   if FreeDEntry^.CMemA<>0 then FreeMem(FreeDEntry^.CMemA,FreeDEntry^.CMemL);
   FreeMem(long(FreeDEntry),sizeof(p_PicListEntry));
end;



procedure SCANANIM;


procedure UNDOLASTFRAME;

begin
   if PlayMode=MODE_LOADDATA then begin
      Frames:=Frames-1;
      l:=DosSeek(FHandle,LastFormPos,OFFSET_BEGINNING);
   end else begin
      ChunkPos:=ChunkPos-8;
      l:=DosSeek(FHandle,ChunkPos,OFFSET_BEGINNING);
   end;
   PlayMode:=MODE_PLAYLOAD;
   PlayFrames:=0;
end;


begin
   while not Errorflag and (ChunkLength>0) do begin
      READCHUNK;
      if (PlayMode=MODE_PLAYLOAD) and (ChunkName<>'FORM') and (MaxLoad<ChunkLength) then begin
         l:=DosSeek(FHandle,-8,OFFSET_CURRENT);
         exit;
      end;

      MaxLoad:=MaxLoad-ChunkLength;
      ChunkPos:=DosSeek(FHandle,0,OFFSET_CURRENT);
      JumpAllowed:=true;
      if ChunkName='FORM' then begin
         LastFormPos:=ChunkPos-8;
         l:=DosSeek(FHandle,4,OFFSET_CURRENT);
         Frames:=Frames+1;
         if Frames=3 then LoopPos:=LastFormPos;
      end else if ChunkName='DLTA' then begin
         if (FirstDEntry.NextPicEntry=NIL) or (LoadDEntry^.FrameNum<Frames) then begin
            l:=AllocMem(sizeof(PicListEntry),MEMF_FAST);
            if l=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            if FirstDEntry.NextPicEntry=NIL then FirstDEntry.NextPicEntry:=ptr(l)
            else LoadDEntry^.NextPicEntry:=ptr(l);
            LoadDEntry:=ptr(l);
            LoadDEntry^:=PicListEntry(NIL,0,Frames,0,0,0,0,0);
         end;
         if LoadDEntry^.PMemA=0 then begin
            DeltaMemL:=ChunkLength;
            DeltaMemA:=AllocMem(DeltaMemL,MEMF_FAST);
            if DeltaMemA=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            l:=DosRead(FHandle,ptr(DeltaMemA),DeltaMemL);
            l:=0;
            DataAddr:=ptr(DeltaMemA);
            i:=0;
            repeat
               i:=i+1;
            until (i=16) or (DataAddr^[i]<>0);
            if (i=16) and (DataAddr^[i]=0) then InEffectiveFrames:=InEffectiveFrames+1;
            LoadDEntry^.Flags:=ANHD.Operation;
            if ANHD.Reltime>1 then LoadDEntry^.MSecs:=ANHD.Reltime*16;
            if DPAN.FPS>0 then LoadDEntry^.MSecs:=round(1000/DPAN.FPS);
            LoadDEntry^.PMemA:=DeltaMemA;
            LoadDEntry^.PMemL:=DeltaMemL;
            if ANHD.Operation in [7,8] then if (ANHD.Bits and $1=$1)
             then LoadDEntry^.Flags:=LoadDEntry^.Flags or $80;
         end;
      end else if ChunkName='SXHD' then begin
         l:=DosRead(Fhandle,^SXHD,SizeOf(SXHeader));
         if (SXHD.UsedChannels>CH_CENTER) or (SXHD.UsedMode>MD_STEREO) then
          WRITEX('BigAnimFX supports only Mono and Stereo!')
         else if SXHD.SampleDepth>8 then
          WRITEX('BigAnimFX supports only 8 Bit samples!')
         else if SXHD.CompressionMethod<>0 then
          WRITEX('BigAnimFX doesn´t supports compressed samples!')
         else begin
            LoopNum:=SXHD.Loop+1;
            SpaceMem:=AllocMem(8,MEMF_CHIP+MEMF_CLEAR);
            WRITEXX('   Sound:  ',intstr(SXHD.SampleDepth),' Bit');
            WRITEXX('           ',intstr(SXHD.PlayFreq),' Hz');
            if SXHD.UsedMode=MD_STEREO then WRITEX('           STEREO (Dolby Surround®)')
            else WRITEX('           MONO');
         end;
      end else if ChunkName='SBDY' then begin
         if not FirstFrame or  (FirstSEntry.NextSndEntry=NIL) then begin
            l:=AllocMem(sizeof(SndListEntry),MEMF_FAST);
            if l=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            if FirstSEntry.NextSndEntry=NIL then FirstSEntry.NextSndEntry:=ptr(l)
            else LoadSEntry^.NextSndEntry:=ptr(l);
            LoadSEntry:=ptr(l);
            LoadSEntry^:=SndListEntry(NIL,Frames,0,0);
            LoadSEntry^.SMemL:=ChunkLength;
            LoadSEntry^.SMemA:=AllocMem(LoadSEntry^.SMemL,MEMF_FAST);
            if LoadSEntry^.SMemA=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            l:=DosRead(Fhandle,ptr(LoadSEntry^.SMemA),ChunkLength);
         end;
      end else if ChunkName='ANHD' then begin
         l:=DosRead(Fhandle,^ANHD,SizeOf(AnimHeader));
         if Frames=1 then begin
            stFrameTime:=0;
            if ANHD.Reltime>1 then stFrameTime:=ANHD.Reltime*16;
            if DPAN.FPS>0 then stFrameTime:=round(1000/DPAN.FPS);
         end;
      end else if ChunkName='DPAN' then
         l:=DosRead(Fhandle,^DPAN,SizeOf(DPaintAnimHeader))
      else if ChunkName='BMHD' then begin
         l:=DosRead(Fhandle,^BMHD,SizeOf(BitMapHeader));
         If not FromWB Then With BMHD Do Begin
            SWidth:=Width;
            SHeight:=Height;
         End;
         With BMHD Do Begin
            s:='   Screen: '+intstr(BMHD.Width)+' x '+intstr(BMHD.Height)+' x '
               +intstr(BMHD.Depth);
            WRITEX(s);
            case Depth of
               1: ColCnt:=2;
               2: ColCnt:=4;
               3: ColCnt:=8;
               4: ColCnt:=16;
               5: ColCnt:=32;
               6: ColCnt:=64;
               7: ColCnt:=128;
               8: ColCnt:=256;
            end;
         End;
         HeadFlag:=true
      end else if ChunkName='CMAP' then begin
         if (MyScreen[1]=NIL) and (ScrMode<>0) then begin
            if not OPENMYSCREENS(ScrMode) then begin
               ScrMode:=GETSCREENMODE(ScrMode);
               if not OPENMYSCREENS(ScrMode) then begin
                  WRITEX('Couldn´t open screen!');
                  exit;
               end;
            end;
            If not Headflag Then FileError;
         end else if MyScreen[1]=NIL then if ScrMode=0 then CMAPPos:=ChunkPos-8;
         if MyScreen[1]<>NIL then begin
            DeltaMemL:=ChunkLength*4+4;
            DeltaMemA:=AllocMem(DeltaMemL,MEMF_FAST);
            if DeltaMemA=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            ChunkMemA:=AllocMem(ChunkLength,MEMF_FAST);
            if ChunkMemA=0 then begin
               UNDOLASTFRAME;
               exit;
            end;
            l:=DosRead(FHandle,ptr(ChunkMemA),ChunkLength);
            CREATECOLORMAP(DeltaMemA,ChunkMemA);
            if Frames>1 then begin
               if (FirstDEntry.NextPicEntry=NIL) or (LoadDEntry^.FrameNum<Frames) then begin
                  l:=AllocMem(sizeof(PicListEntry),MEMF_FAST);
                  if l=0 then begin
                     UNDOLASTFRAME;
                     exit;
                  end;
                  if FirstDEntry.NextPicEntry=NIL then FirstDEntry.NextPicEntry:=ptr(l)
                  else LoadDEntry^.NextPicEntry:=ptr(l);
                  LoadDEntry:=ptr(l);
                  LoadDEntry^:=PicListEntry(NIL,0,Frames,0,0,0,0,0);
               end;
               if LoadDEntry^.CMemA=0 then begin
                  LoadDEntry^.CMemA:=DeltaMemA;
                  LoadDEntry^.CMemL:=DeltaMemL;
               end else FreeMem(DeltaMemA,DeltaMemL);
            end;
            if Frames=1 then begin
               LoadRGB32(^MyScreen[AScr]^.ViewPort,ptr(DeltaMemA));
               LoadRGB32(^MyScreen[3-AScr]^.ViewPort,ptr(DeltaMemA));
               FreeMem(DeltaMemA,DeltaMemL);
            end;
            FreeMem(ChunkMemA,ChunkLength);
         end;
      end else if ChunkName='CAMG' then begin
          l:=DosRead(FHandle,^ScrMode,4);
          if CMAPPos<>0 then begin
             l:=DosSeek(FHandle,CMAPPos,OFFSET_BEGINNING);
             JumpAllowed:=false; CMAPPos:=0;
          end;
      end else If ChunkName='BODY' Then Begin
         if (CMAPPos<>0) and (ScrMode=0) then begin
            Scrmode:=GENLOCK_VIDEO;
            if BMHD.Height>256 then ScrMode:=Scrmode or LACE;
            if BMHD.Width>320 then ScrMode:=ScrMode or HIRES;
            l:=DosSeek(FHandle,CMAPPos,OFFSET_BEGINNING);
            JumpAllowed:=false; CMAPPos:=0;
         end else begin
            DeltaMemA:=AllocMem(ChunkLength,0);
            if DeltaMemA=0 then begin
               DosClose(FHandle);
               WRITEX('Not enough memory!');
               exit;
            end;
            l:=DosRead(FHandle,ptr(DeltaMemA),ChunkLength);
            if l<ChunkLength then begin
               FILEERROR;
               DosClose(FHandle);
               exit;
            end;
            BodyAddr:=DeltaMemA;
            FirstFrame:=false;
            If not HeadFlag Then FileError;
            LineSize:=(MyScreen[AScr]^.Width+7) div 8;
            For Zeile:=0 to BMHD.Height-1 Do
             For Plane:=0 to pred(BMHD.Depth) Do
              LiesZeile(Long(MyScreen[Ascr]^.BitMap.Planes[Plane])+Zeile*MyScreen[AScr]^.BitMap.BytesPerRow,Plane);
            FreeMem(DeltaMemA,ChunkLength);
         end;
      End;
      if JumpAllowed and (ChunkName<>'FORM') then begin
         if odd(ChunkLength) then ChunkPos:=ChunkPos+1;
         l:=DosSeek(FHandle,ChunkPos+ChunkLength,OFFSET_BEGINNING);
      end;
   End;
   if LoopNum<=1 then PlayMode:=MODE_PLAYALONE else begin
      ErrorFlag:=false;
      PlayMode:=MODE_PLAYLOAD;
      LoopNum:=LoopNum-1;
      l:=DosSeek(FHandle,LoopPos,OFFSET_BEGINNING);
   end;
end;



procedure PLAYANIM;

begin
   MaxLoad:=0;
   while MyDEntry<>NIL do begin
      PlayFrames:=PlayFrames+1;
      PlayFrame:=PlayFrame+1;
      if SpaceMem<>0 then
       while (MySEntry^.FrameNum<MyDEntry^.FrameNum) and (MySEntry^.NextSndEntry<>NIL)
       do begin
         LastSEntry:=MySEntry;
         MySEntry:=MySEntry^.NextSndEntry;
         FREESENTRY(LastSEntry);
       end;
      HANDLESPACEMEM;
      if PlaySound[AScr] and (MySEntry^.SMemA<>0) then begin
         CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],MySEntry^.SMemL);
         SPAddrA^:=SoundMemA[AScr];   SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
         SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
         MaxLoad:=round(((2*LoadValue)/SXHD.PlayFreq)*SoundModeLength);
         DMACON_WRITE^:=$8003;
      end else begin
         DMACON_WRITE^:=$0003;
         if MyDEntry^.MSecs=0 then MaxLoad:=MaxLoad+((LoadValue*12) div 1000)
         else MaxLoad:=MaxLoad+((LoadValue*MyDEntry^.MSecs) div 1000);
         EndMSec:=IBase^.Micros+(MyDEntry^.MSecs*1000);
         EndSec:=IBase^.Seconds;
         if EndMSec>=1000000 then begin
            l:=EndMSec div 1000000;
            EndMSec:=EndMSec-(l*1000000);
            EndSec:=EndSec+l;
         end;
      end;
      DeltaMemA:=MyDEntry^.PMemA; DeltaMemL:=MyDEntry^.PMemL;
      if LData^ and 64=0 then MyDEntry^.Flags:=255;
      case MyDEntry^.Flags of
          $5: ANIM5;
          $7: ANIM7_16;
         $87: ANIM7_32;
          $8: ANIM8_16;
         $88: ANIM8_32;
         otherwise begin
            DMACON_WRITE^:=$000F;
            if MyDEntry^.Flags<>255 then WRITEXX('Unknown ANIM-format (ANIM ',intstr(MyDEntry^.Flags and not $80),')!');
            ScreenToBack(MyScreen[AScr]);
            ScreenToBack(MyScreen[3-AScr]);
            while MyDEntry<>NIL do begin
               LastDEntry:=MyDEntry;
               MyDEntry:=MyDEntry^.NextPicEntry;
               FREEDENTRY(LastDEntry);
            end;
            if FirstSEntry.NextSndEntry<>NIL then
             while MySEntry<>NIL do begin
               LastSEntry:=MySEntry;
               MySEntry:=MySEntry^.NextSndEntry;
               FREESENTRY(LastSEntry);
            end;
            exit;
         end;
      end;
      if MyDEntry^.CMemA<>0 then begin
         LoadRGB32(^MyScreen[AScr]^.ViewPort,ptr(MyDEntry^.CMemA));
         if (MyDEntry^.NextPicEntry<>NIL) and (MyDEntry^.NextPicEntry^.CMemA=0)
          then LoadRGB32(^MyScreen[3-AScr]^.ViewPort,ptr(MyDEntry^.CMemA))
      end;
      if PlaySound[AScr] then begin
         if (PlayMode=MODE_PLAYLOAD) and (PlayFrames>3) then SCANANIM;
         repeat until NTREQ_READ^ and $0180=$180;
         NTREQ_WRITE^:=$0180;
      end else if SndPlay then begin
         repeat until NTREQ_READ^ and $0180=$180;
         DMACON_WRITE^:=$0003;
         SndPlay:=false;
      end;
      ScreenToFront(MyScreen[AScr]);
      AScr:=3-AScr;
      if SpaceMem=0 then begin
         if (PlayMode=MODE_PLAYLOAD) and (PlayFrames>3) then SCANANIM;
         repeat until (IBase^.Seconds>EndSec)
         or ((IBase^.Seconds=EndSec) and (IBase^.Micros>=EndMSec));
      end;

      if (PlayMode=MODE_PLAYLOAD) then if
       (MyDEntry^.NextPicEntry=NIL) or (MyDEntry^.NextPicEntry^.NextPicEntry=NIL)
       then begin
         PlayFrames:=0;
         PlayMode:=MODE_LOADDATA;
         SCANANIM;
         if LoopNum>1 then begin
            PlayMode:=MODE_LOADDATA;
            SCANANIM;
         end;
      end;

      LastDEntry:=MyDEntry;
      MyDEntry:=MyDEntry^.NextPicEntry;
      FREEDENTRY(LastDEntry);
      if PlaySound[AScr] and (MySEntry<>NIL) then begin
         LastSEntry:=MySEntry;
         MySEntry:=MySEntry^.NextSndEntry;
         FREESENTRY(LastSEntry);
      end;
   end;
end;



Begin
   INITVARS;
   Fhandle:=DosOpen(PathFR,MODE_OLDFILE);
   If FHandle=0 Then begin
      WRITEXX('Couldn´t find file »',PathFR,'« !');
      exit;
   End;
   WRITEXX('   Name:   ',PathFR,'');
   READCHUNK;
   if ChunkName<>'FORM' then begin
      READCDXL;
      DosClose(FHandle);
      exit;
   end;
   l:=DosRead(FHandle,^ChunkName,4);
   If ChunkName<>'ANIM' Then Begin
      WRITEXX('No ANIM-File (',ChunkName,')!');
      DosClose(FHandle);
      exit;
   end;
   ANHD.RelTime:=0;
   DPAN.FPS:=0;
   SoundModeLength:=0;
   PlayMode:=MODE_LOADDATA;
   StartSec:=IBase^.Seconds;
   StartMSec:=IBase^.Micros;
   MySEntry:=NIL;
   stFrameTime:=0;
   LoopNum:=1;
   SCANANIM;
   if not HeadFlag or (Frames<=1) then exit;
   EndSec:=IBase^.Seconds;
   EndMSec:=IBase^.Micros;
   l:=DosSeek(FHandle,0,OFFSET_CURRENT);
   EndSec:=round(((EndSec-StartSec)*1000)+((EndMSec-StartMSec)/1000));
   LoadValue:=round((l/EndSec)*950); {95%}
   s:=intstr(LoadValue);
   if PlayMode=MODE_PLAYLOAD then WRITEXX('   Filescan: ',s,' Bytes/sec');
   PlayFrame:=1;
   PlaySound[1]:=true;   PlaySound[2]:=true;
   MySEntry:=FirstSEntry.NextSndEntry;
   HANDLESPACEMEM;
   SndPlay:=false;
   StartSec:=IBase^.Seconds; StartMSec:=IBase^.Micros;
   if MySEntry<>NIL then begin
      SPVolA^:=SXHD.FixedVolume;    SPVolB^:=SXHD.FixedVolume;
      SPFreqA^:=SXHD.PlayRate;      SPFreqB^:=SXHD.PlayRate;
   end;
   if PlaySound[AScr] then begin
      CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],MySEntry^.SMemL);
      SPAddrA^:=SoundMemA[AScr];    SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
      SPLengthA^:=SoundModeLength;  SPLengthB^:=SoundModeLength;
      ScreenToFront(MyScreen[AScr]);
      DMACON_WRITE^:=$8003; NTREQ_WRITE^:=$0180;
      LastSEntry:=MySEntry;
      MySEntry:=MySEntry^.NextSndEntry;
      FREESENTRY(LastSEntry);
      SndPlay:=true;
   end else begin
      EndMSec:=IBase^.Micros+(stFrameTime*1000);
      EndSec:=IBase^.Seconds;
      if EndMSec>=1000000 then begin
         l:=EndMSec div 1000000;
         EndMSec:=EndMSec-(l*1000000);
         EndSec:=EndSec+l;
      end;
      ScreenToFront(MyScreen[AScr]);
      repeat until (IBase^.Seconds>EndSec)
      or ((IBase^.Seconds=EndSec) and (IBase^.Micros>=EndMSec));
   end;
   AScr:=3-AScr;
   ClipBlit(^MyScreen[3-AScr]^.RastPort,0,YOffset,^MyScreen[Ascr]^.RastPort,0,YOffset,BMHD.Width,BMHD.Height,192);
   MyDEntry:=FirstDEntry.NextPicEntry;
   MyAnimType:=MyDEntry^.Flags;
   PLAYANIM;

   HANDLESPACEMEM;
   if PlaySound[AScr] and (MySEntry<>NIL) then begin
      CopyMemQuick(MySEntry^.SMemA,SoundMemA[AScr],SoundMemL[AScr]);
      SPAddrA^:=SoundMemA[AScr];   SPAddrB^:=SoundMemA[AScr]+SoundModeOffset;
      SPLengthA^:=SoundModeLength; SPLengthB^:=SoundModeLength;
      repeat until NTREQ_READ^ and $0180<>0;
      DMACON_WRITE^:=$8003;
      NTREQ_WRITE^:=$0180;
      WaitTOF;
      SPAddrA^:=SpaceMem; SPAddrB^:=SpaceMem;
      SPLengthA^:=1;      SPLengthB^:=1;
      repeat until NTREQ_READ^ and $0180=$0180;
   end else if SndPlay then repeat until NTREQ_READ^ and $0180=$180;
   DMACON_WRITE^:=$000F;
   DosClose(FHandle);
   WRITEXX('   Played: ',intstr(Frames),' Frames');
   if InEffectiveFrames>0 then WRITEXX('   Non-optimal ANIM-File! ',intstr(InEffectiveFrames),' empty frames found!');
   case MyAnimType of
       $5: WRITEX('           ANIM 5');
       $7: WRITEX('           ANIM 7, 16 Bit');
      $87: WRITEX('           ANIM 7, 32 Bit');
       $8: WRITEX('           ANIM 8, 16 Bit');
      $88: WRITEX('           ANIM 8, 32 Bit');
      otherwise;
   end;
   l:=round((IBase^.Seconds-StartSec)*100+(IBase^.Micros-StartMSec)/10000);
   WRITEXX('          ',realstr(l/100,2),' sec');
End;



begin
   OpenLib(intbase,'intuition.library',39);
   OpenLib(gfxbase,'graphics.library' ,39);
   OpenLib(DosBase,'dos.library',39);
   INITCHANNELS;
   DMACON_WRITE^:=$000F;
   i:=SetTaskPri(FindTask(NIL),10);
   FileName:='';
   PathFR:=parameterstr;
   PathFR[parameterlen]:=chr(0);
   if FromWB then begin
      reset(f,'CON:0/10/640/200/BigAnimFX-Output');
      if IOResult<>0 then exit
   end;
   WRITEX('');
   WRITEX('BigAnimFX V 1.57, © by QXC & VWP');
   if AvailMem(MEMF_FAST)=0 then WRITEX('No FAST-RAM found!!')
   else if PathFR='' then begin
      OpenLib(RTBase,'reqtools.library',0);
      MyFReq:=rtAllocRequestA(RT_FILEREQ,NIL);
      if MyFReq<>NIL then begin
         Tags:=TagArr(0,0,0,0,0,0,0,0,0,0);
         l:=rtChangeReqAttrA(MyFReq,^Tags);
         repeat
            PathFR:=FileName;
            l:=rtFileRequestA(MyFReq,PathFR,'Load IFF-ANIM',^Tags);
            if l<>0 then begin
               WRITEX('');
               s:=MyFReq^.Dir;
               FileName:=PathFR;
               if s<>'' then if not (s[length(s)] in ['/',':']) then
                PathFR:=s+'/'+PathFR else PathFR:=s+PathFR;
               READIFF;
               DMACON_WRITE^:=$000F;
               GAMEEXIT;
               l:=1;
            end;
         until l=0;
         rtFreeRequest(MyFReq);
      end;
      CloseLib(RTBase);
   end else if PathFR='?' then begin
      WRITEX('   A animplayer for CDXL and IFF-ANIM 5, 7 and 8 with soundsupport');
      WRITEX('   BigAnimFX is FREEWARE and plays anims direct from disk');
      WRITEX('   Usage: BigAnimFX <filename> for CLI-handling');
      WRITEX('          BigAnimFX            for a filerequester');
      WRITEX('');
      WRITEX('   ANIMs with sound can be created using the WaveTracer®-softwarepackage,');
      WRITEX('   also developed and distributed by Virtual Worlds Productions®');
   end else begin
      READIFF;
      DMACON_WRITE^:=$000F;
      GAMEEXIT;
   end;
   WRITEX('');
   if FromWB then begin
      delay(100);
      close(f);
   end;
   CloseLib(intbase);
   CloseLib(gfxbase);
   CloseLib(DosBase);
end.